Wine Quality
Caso Final Módulo Estadística - Wine Quality
Dataset
https://archive.ics.uci.edu/ml/datasets/wine+quality
Descripción del Dataset
Esta base de datos, consta de dos conjuntos de datos relacionados con variantes rojas y blancas del vino portugués “Vinho Verde”.
Variables del Dataset
Variables de entrada:
* fixed acidity: cuantitativa.
* volatile acidity: cuantitativa.
* citric acid: cuantitativa.
* residual sugar: cuantitativa.
* chlorides: cuantitativa.
* free sulfur dioxide: cuantitativa.
* total sulfur dioxide: cuantitativa.
* density: cuantitativa.
* pH: cuantitativa.
* sulphates: cuantitativa.
* alcohol: cuantitativa.
Variable de salida:
* quality (score between 0 and 10): cualitativa.
Objetivo del caso práctico
Realizar un modelo de regresión lineal que permita representar la calidad (quality) del vino a través de las demás variables. Teniendo en cuenta cuáles de estas son más significativas.
Solución del caso práctico
Importar librerías
library(tidyverse)Registered S3 methods overwritten by 'dbplyr':
method from
print.tbl_lazy
print.tbl_sql
── Attaching packages ─────────────────────────────────────────────────────────────────────────────────────────────────────────────────── tidyverse 1.3.1 ──
✔ ggplot2 3.3.6 ✔ purrr 0.3.4
✔ tibble 3.1.7 ✔ dplyr 1.0.9
✔ tidyr 1.2.0 ✔ stringr 1.4.0
✔ readr 2.1.2 ✔ forcats 0.5.1
── Conflicts ────────────────────────────────────────────────────────────────────────────────────────────────────────────────────── tidyverse_conflicts() ──
✖ dplyr::filter() masks stats::filter()
✖ dplyr::lag() masks stats::lag()library(GGally)Registered S3 method overwritten by 'GGally':
method from
+.gg ggplot2library(corrplot)corrplot 0.92 loadedlibrary(janitor)
Attaching package: ‘janitor’
The following objects are masked from ‘package:stats’:
chisq.test, fisher.testLectura del dataset
Se leen los dos archivos correspondientes a vinos rojos y vinos blancos, para proceder a unirlos en un único dataframe que contenga todos los datos. Esto con el fin de tener más valores. Se utiliza también el método clean_names() para mejorar el nombre de las columnas del dataset.
wine_quality <- read_delim('https://archive.ics.uci.edu/ml/machine-learning-databases/wine-quality/winequality-white.csv', delim = ';') %>%
bind_rows(read_delim('https://archive.ics.uci.edu/ml/machine-learning-databases/wine-quality/winequality-red.csv', delim = ';')) %>%
clean_names()Rows: 4898 Columns: 12── Column specification ────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────
Delimiter: ";"
dbl (12): fixed acidity, volatile acidity, citric acid, residual sugar, chlorides, free sulfur dioxide, total sulfur dioxide, density, pH, sulphates, al...
ℹ Use `spec()` to retrieve the full column specification for this data.
ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.Rows: 1599 Columns: 12── Column specification ────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────
Delimiter: ";"
dbl (12): fixed acidity, volatile acidity, citric acid, residual sugar, chlorides, free sulfur dioxide, total sulfur dioxide, density, pH, sulphates, al...
ℹ Use `spec()` to retrieve the full column specification for this data.
ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.Se crea un dataframe con el mismo contenido anterior, pero transformando la calidad del vino a tipo factor.
wine_quality_factor <- mutate(wine_quality, quality = factor(quality, ordered = TRUE))Análisis exploratorio
Primero se procede a generar una vista previa del dataset, utilizando el comando glimpse, que permite conocer la cantidad de columnas, filas, y el tipo de dato de cada una.
glimpse(wine_quality)Rows: 6,497
Columns: 12
$ fixed_acidity <dbl> 7.0, 6.3, 8.1, 7.2, 7.2, 8.1, 6.2, 7.0, 6.3, 8.1, 8.1, 8.6, 7.9, 6.6, 8.3, 6.6, 6.3, 6.2, 7.4, 6.5, 6.2, 6.4, 6.8, 7.6, 6.6, …
$ volatile_acidity <dbl> 0.27, 0.30, 0.28, 0.23, 0.23, 0.28, 0.32, 0.27, 0.30, 0.22, 0.27, 0.23, 0.18, 0.16, 0.42, 0.17, 0.48, 0.66, 0.34, 0.31, 0.66,…
$ citric_acid <dbl> 0.36, 0.34, 0.40, 0.32, 0.32, 0.40, 0.16, 0.36, 0.34, 0.43, 0.41, 0.40, 0.37, 0.40, 0.62, 0.38, 0.04, 0.48, 0.42, 0.14, 0.48,…
$ residual_sugar <dbl> 20.70, 1.60, 6.90, 8.50, 8.50, 6.90, 7.00, 20.70, 1.60, 1.50, 1.45, 4.20, 1.20, 1.50, 19.25, 1.50, 1.10, 1.20, 1.10, 7.50, 1.…
$ chlorides <dbl> 0.045, 0.049, 0.050, 0.058, 0.058, 0.050, 0.045, 0.045, 0.049, 0.044, 0.033, 0.035, 0.040, 0.044, 0.040, 0.032, 0.046, 0.029,…
$ free_sulfur_dioxide <dbl> 45, 14, 30, 47, 47, 30, 30, 45, 14, 28, 11, 17, 16, 48, 41, 28, 30, 29, 17, 34, 29, 19, 41, 25, 16, 56, 35, 32, 17, 37, 20, 7…
$ total_sulfur_dioxide <dbl> 170, 132, 97, 186, 186, 97, 136, 170, 132, 129, 63, 109, 75, 143, 172, 112, 99, 75, 171, 133, 75, 102, 122, 168, 142, 245, 14…
$ density <dbl> 1.0010, 0.9940, 0.9951, 0.9956, 0.9956, 0.9951, 0.9949, 1.0010, 0.9940, 0.9938, 0.9908, 0.9947, 0.9920, 0.9912, 1.0002, 0.991…
$ p_h <dbl> 3.00, 3.30, 3.26, 3.19, 3.19, 3.26, 3.18, 3.00, 3.30, 3.22, 2.99, 3.14, 3.18, 3.54, 2.98, 3.25, 3.24, 3.33, 3.12, 3.22, 3.33,…
$ sulphates <dbl> 0.45, 0.49, 0.44, 0.40, 0.40, 0.44, 0.47, 0.45, 0.49, 0.45, 0.56, 0.53, 0.63, 0.52, 0.67, 0.55, 0.36, 0.39, 0.53, 0.50, 0.39,…
$ alcohol <dbl> 8.8, 9.5, 10.1, 9.9, 9.9, 10.1, 9.6, 8.8, 9.5, 11.0, 12.0, 9.7, 10.8, 12.4, 9.7, 11.4, 9.6, 12.8, 11.3, 9.5, 12.8, 11.0, 10.5…
$ quality <dbl> 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 5, 5, 5, 7, 5, 7, 6, 8, 6, 5, 8, 7, 8, 5, 6, 6, 6, 6, 6, 7, 6, 6, 6, 6, 5, 5, 5, 6, 5, 5, 6, 6,…Como se observa con el comando anterior, todos los datos son de tipo double. Por esto, conviene ejecutar el comando summary, para así obtener un resumen estadístico del conjunto de datos.
summary(wine_quality_factor) fixed_acidity volatile_acidity citric_acid residual_sugar chlorides free_sulfur_dioxide total_sulfur_dioxide density
Min. : 3.800 Min. :0.0800 Min. :0.0000 Min. : 0.600 Min. :0.00900 Min. : 1.00 Min. : 6.0 Min. :0.9871
1st Qu.: 6.400 1st Qu.:0.2300 1st Qu.:0.2500 1st Qu.: 1.800 1st Qu.:0.03800 1st Qu.: 17.00 1st Qu.: 77.0 1st Qu.:0.9923
Median : 7.000 Median :0.2900 Median :0.3100 Median : 3.000 Median :0.04700 Median : 29.00 Median :118.0 Median :0.9949
Mean : 7.215 Mean :0.3397 Mean :0.3186 Mean : 5.443 Mean :0.05603 Mean : 30.53 Mean :115.7 Mean :0.9947
3rd Qu.: 7.700 3rd Qu.:0.4000 3rd Qu.:0.3900 3rd Qu.: 8.100 3rd Qu.:0.06500 3rd Qu.: 41.00 3rd Qu.:156.0 3rd Qu.:0.9970
Max. :15.900 Max. :1.5800 Max. :1.6600 Max. :65.800 Max. :0.61100 Max. :289.00 Max. :440.0 Max. :1.0390
p_h sulphates alcohol quality
Min. :2.720 Min. :0.2200 Min. : 8.00 3: 30
1st Qu.:3.110 1st Qu.:0.4300 1st Qu.: 9.50 4: 216
Median :3.210 Median :0.5100 Median :10.30 5:2138
Mean :3.219 Mean :0.5313 Mean :10.49 6:2836
3rd Qu.:3.320 3rd Qu.:0.6000 3rd Qu.:11.30 7:1079
Max. :4.010 Max. :2.0000 Max. :14.90 8: 193
9: 5 Para conocer el comportamiento de las variables numéricas y su relación, se grafica una matriz de correlación:
corrplot(cor(wine_quality), method = 'square', type = 'lower', diag = FALSE, addCoef.col = 'black')
A través de la gráfica anterior podemos notar que:
Las variables con mayor correlación son total_sulfur_dioxide y free_sulfur_dioxide, siendo esta correlación postivia. Esto tiene sentido porque la cantidad total de dióxido de sulfuro va a estar relacionada con que el vino tenga o no este componente.
Las variables alcohol y density tienen una fuerte correlación negativa, lo cual significa que si una disminuye, la otra también.
Podemos observar una correlación positiva fuerte de la variable residual_sugar con las variables free_sulfur_dioxide, total_sulfur_dioxide y density. Así también, entre la variable fixed_acidity y density.
Existen otras variables con alta correlación (tanto positiva, como negativa), en general las variables se encuentran correlacionadas entre sí en su mayoría.
Para ver el comportamiento de las variables de forma gráfica entre sí, podemos crear una gráfica con ggpairs. Este método nos permitirá graficar cada variable con las demás para cuestiones de análisis.
ggpairs(wine_quality_factor, upper = list(continuous = 'box_no_facet'))
A través de las visualizaciones obtenidas anteriormente, podemos sacar algunas conclusiones:
Las gráficas de densidad nos muestran que realmente no todas las variables siguen una distribución normal. Las que más se aproximan a una son: fixed_acidity, p_h, y quality.
En términos generales, la calidad del vino es media. No existen vinos con calidades menores a 3, ni vinos con calidad perfecta de 10. Los valores se centran más que todo en calidades como 5, 6 y 7.
El dataset contiene muchos valores que se podrían considerar outliers. Esto podría ser un factor que altere el modelo.
No todas las variables se comportan de forma lineal. Las que poseen una mayor linealidad son: alcohol, p_h y total_sulfur_dioxide.
Se podría decir que el conjunto de datos es irregular, y que, aunque se vaya a realizar una regresión lineal, este modelo no podrá explicar realmente los datos. Por lo que muy probablemente el R2 sea bajo.
Regresión Lineal
Se iniciará creando un modelo que utilice todas las variables del dataset para calcular la calidad del vino (quality), para así analizar si es posible mejorar el modelo.
model <- lm(quality ~ ., data = wine_quality)
summary(model)
Call:
lm(formula = quality ~ ., data = wine_quality)
Residuals:
Min 1Q Median 3Q Max
-3.7569 -0.4597 -0.0412 0.4694 2.9907
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 5.576e+01 1.189e+01 4.688 2.81e-06 ***
fixed_acidity 6.768e-02 1.557e-02 4.346 1.41e-05 ***
volatile_acidity -1.328e+00 7.737e-02 -17.162 < 2e-16 ***
citric_acid -1.097e-01 7.962e-02 -1.377 0.168
residual_sugar 4.356e-02 5.156e-03 8.449 < 2e-16 ***
chlorides -4.837e-01 3.327e-01 -1.454 0.146
free_sulfur_dioxide 5.970e-03 7.511e-04 7.948 2.22e-15 ***
total_sulfur_dioxide -2.481e-03 2.767e-04 -8.969 < 2e-16 ***
density -5.497e+01 1.214e+01 -4.529 6.04e-06 ***
p_h 4.393e-01 9.037e-02 4.861 1.20e-06 ***
sulphates 7.683e-01 7.612e-02 10.092 < 2e-16 ***
alcohol 2.670e-01 1.673e-02 15.963 < 2e-16 ***
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Residual standard error: 0.7353 on 6485 degrees of freedom
Multiple R-squared: 0.2921, Adjusted R-squared: 0.2909
F-statistic: 243.3 on 11 and 6485 DF, p-value: < 2.2e-16Se puede observar que el R2 es bastante bajo, indicando que el modelo sólo explica aproximadamente un 29% de los datos. También, se puede observar que todas las variables se consideran significativas dentro del modelo, excepto citric_acid y chlorides.
Se procede a graficar el resultado de la regresión lineal.
plot(model)
A partir de los gráficos anteriores se puede decir:
Residuals vs Fitted (Residuos vs Valores Ajustados): lo ideal sería poder visualizar puntos aleatorios a ambos lados del cero sin detectar un patrón. En este caso podemos ver patrones de líneas en los datos, por lo que se puede decir que el modelo calculados no es realmente apropiado para este conjunto de datos.
Normal QQ (Normalidad de los residuos): idealmente, los residuos se deben distribuir aproximadamente alrededor de la línea de referencia sin patrones notables, esto sugiere que el modelo se ajusta adecuadamente a los datos y que los residuos siguen una distribución normal. En este caso se observan colas largas los extremos, esto indica que el modelo no es adecuado y que se necesitan ajustes.
Scale - Location (Escala - Ubicación): La gráfica de escala-ubicación (scale-location) muestra si la varianza de los residuos es constante en diferentes niveles de la variable predictora. En la gráfica, si la varianza de los residuos es constante, los puntos deben estar distribuidos de manera uniforme alrededor de una línea horizontal. En este caso podemos observar patrones en los puntos, y la línea que representa la homocedasticidad, no es totalmente horizontal, lo que indica que la varianza de los errores no es constante a través de los datos. Es importante que exista homocedasticidad en los datos para que la regresión lineal tenga sentido, por eso se puede decir que el modelo no es adecuado.
Residuals vs Leverage (Residuales vs Influencia): los puntos que se encuentran en la parte superior derecha o inferior derecha de la gráfica pueden ser puntos influyentes o atípicos (fuera de la línea de distancia de Cook). En general, la mayoría de los puntos caen dentro de la línea de distancia de Cook. Sin embargo, hay puntos que están muy alejados de los demás, por esto se deberían investigar para determinar si son valores atípicos o si realmente tiene que ver con el modelo.
Es decir, a partir de las gráficas anteriores y sus conclusiones, podemos afirmar que el modelo no es bueno para explicar los datos.
Se podrían eliminar del modelo aquellas variables no significativas para ver cómo influyen en el modelo:
wine_quality_sig <- select(wine_quality, !c(chlorides, citric_acid))
model_sig <- lm(quality ~ ., data = wine_quality_sig)
summary(model_sig)
Call:
lm(formula = quality ~ ., data = wine_quality_sig)
Residuals:
Min 1Q Median 3Q Max
-3.7361 -0.4627 -0.0361 0.4649 2.9904
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 6.004e+01 1.165e+01 5.156 2.60e-07 ***
fixed_acidity 6.621e-02 1.501e-02 4.412 1.04e-05 ***
volatile_acidity -1.304e+00 7.071e-02 -18.445 < 2e-16 ***
residual_sugar 4.535e-02 5.025e-03 9.024 < 2e-16 ***
free_sulfur_dioxide 5.934e-03 7.501e-04 7.911 2.98e-15 ***
total_sulfur_dioxide -2.503e-03 2.716e-04 -9.217 < 2e-16 ***
density -5.942e+01 1.187e+01 -5.004 5.75e-07 ***
p_h 4.782e-01 8.838e-02 5.411 6.50e-08 ***
sulphates 7.378e-01 7.451e-02 9.903 < 2e-16 ***
alcohol 2.647e-01 1.666e-02 15.886 < 2e-16 ***
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Residual standard error: 0.7355 on 6487 degrees of freedom
Multiple R-squared: 0.2916, Adjusted R-squared: 0.2906
F-statistic: 296.7 on 9 and 6487 DF, p-value: < 2.2e-16Luego de realizar este nuevo modelo, podemos ver que el R2 realmente no cambia mucho. Incluso disminuye ligeramente. Por lo que, a pesar de todo, el modelo anterior sigue siendo algo mejor a comparación de este.
Se procede a utilizar el método step que usa el criterio de información de Akaike (AIC) para evaluar y comparar modelos de regresión con diferentes combinaciones de variables. De esta forma se intentará mejorar el modelo, tomando aquel con el AIC más bajo.
model_step <- step(model, direction = 'backward')Start: AIC=-3982.79
quality ~ fixed_acidity + volatile_acidity + citric_acid + residual_sugar +
chlorides + free_sulfur_dioxide + total_sulfur_dioxide +
density + p_h + sulphates + alcohol
Df Sum of Sq RSS AIC
- citric_acid 1 1.026 3507.6 -3982.9
<none> 3506.5 -3982.8
- chlorides 1 1.143 3507.7 -3982.7
- fixed_acidity 1 10.214 3516.7 -3965.9
- density 1 11.090 3517.6 -3964.3
- p_h 1 12.777 3519.3 -3961.2
- free_sulfur_dioxide 1 34.155 3540.7 -3921.8
- residual_sugar 1 38.595 3545.1 -3913.7
- total_sulfur_dioxide 1 43.495 3550.0 -3904.7
- sulphates 1 55.073 3561.6 -3883.5
- alcohol 1 137.789 3644.3 -3734.4
- volatile_acidity 1 159.265 3665.8 -3696.2
Step: AIC=-3982.89
quality ~ fixed_acidity + volatile_acidity + residual_sugar +
chlorides + free_sulfur_dioxide + total_sulfur_dioxide +
density + p_h + sulphates + alcohol
Df Sum of Sq RSS AIC
<none> 3507.6 -3982.9
- chlorides 1 1.542 3509.1 -3982.0
- fixed_acidity 1 9.265 3516.8 -3967.7
- density 1 11.166 3518.7 -3964.2
- p_h 1 13.364 3520.9 -3960.2
- free_sulfur_dioxide 1 34.505 3542.1 -3921.3
- residual_sugar 1 38.337 3545.9 -3914.3
- total_sulfur_dioxide 1 47.131 3554.7 -3898.2
- sulphates 1 54.525 3562.1 -3884.7
- alcohol 1 136.769 3644.3 -3736.4
- volatile_acidity 1 175.494 3683.1 -3667.7summary(model_step)
Call:
lm(formula = quality ~ fixed_acidity + volatile_acidity + residual_sugar +
chlorides + free_sulfur_dioxide + total_sulfur_dioxide +
density + p_h + sulphates + alcohol, data = wine_quality)
Residuals:
Min 1Q Median 3Q Max
-3.7408 -0.4614 -0.0380 0.4712 2.9885
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 5.594e+01 1.189e+01 4.703 2.61e-06 ***
fixed_acidity 6.270e-02 1.515e-02 4.139 3.53e-05 ***
volatile_acidity -1.287e+00 7.144e-02 -18.014 < 2e-16 ***
residual_sugar 4.340e-02 5.155e-03 8.420 < 2e-16 ***
chlorides -5.550e-01 3.287e-01 -1.689 0.0913 .
free_sulfur_dioxide 5.998e-03 7.509e-04 7.988 1.61e-15 ***
total_sulfur_dioxide -2.546e-03 2.727e-04 -9.336 < 2e-16 ***
density -5.515e+01 1.214e+01 -4.544 5.62e-06 ***
p_h 4.481e-01 9.015e-02 4.971 6.83e-07 ***
sulphates 7.637e-01 7.606e-02 10.041 < 2e-16 ***
alcohol 2.649e-01 1.666e-02 15.903 < 2e-16 ***
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Residual standard error: 0.7354 on 6486 degrees of freedom
Multiple R-squared: 0.2919, Adjusted R-squared: 0.2908
F-statistic: 267.4 on 10 and 6486 DF, p-value: < 2.2e-16Por ende, la regresión lineal final sería:
summary(lm(model_step))
Call:
lm(formula = model_step)
Residuals:
Min 1Q Median 3Q Max
-3.7408 -0.4614 -0.0380 0.4712 2.9885
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 5.594e+01 1.189e+01 4.703 2.61e-06 ***
fixed_acidity 6.270e-02 1.515e-02 4.139 3.53e-05 ***
volatile_acidity -1.287e+00 7.144e-02 -18.014 < 2e-16 ***
residual_sugar 4.340e-02 5.155e-03 8.420 < 2e-16 ***
chlorides -5.550e-01 3.287e-01 -1.689 0.0913 .
free_sulfur_dioxide 5.998e-03 7.509e-04 7.988 1.61e-15 ***
total_sulfur_dioxide -2.546e-03 2.727e-04 -9.336 < 2e-16 ***
density -5.515e+01 1.214e+01 -4.544 5.62e-06 ***
p_h 4.481e-01 9.015e-02 4.971 6.83e-07 ***
sulphates 7.637e-01 7.606e-02 10.041 < 2e-16 ***
alcohol 2.649e-01 1.666e-02 15.903 < 2e-16 ***
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Residual standard error: 0.7354 on 6486 degrees of freedom
Multiple R-squared: 0.2919, Adjusted R-squared: 0.2908
F-statistic: 267.4 on 10 and 6486 DF, p-value: < 2.2e-16Como se puede observar el modelo realmente no cambia mucho, y eliminar variables al modelo original no aumenta el R2. Por lo que se podría decir que el mejor modelo para regresión lineal contiene todas las variables del dataset.
Conclusión
Aunque se ha obtenido una regresión lineal correcta, se puede decir que esta no explica el modelo realmente, ya que sólo lo hacce para el 29% de los datos. Esto puede deberse a diferentes factores como la normalidad o linealidad de los datos. Por lo que se recomendaría analizar estos datos a partir de otros modelos que se adapten mejor a estos.